home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / VISUALBA / BOZOL2.ZIP / DB.BAS < prev    next >
BASIC Source File  |  1994-02-08  |  35KB  |  1,022 lines
  1. '       DBASE III COMPATIBLE DATA FILE INTERFACE for PowerBASIC 3.0+
  2. '
  3. ' dBASE interface, screen field editing, and indexing routines by Erik Olson
  4. ' with Joe Vest's BT() BTree subroutine and a modified field input routine
  5. ' by David Zarnitsky.  Special thanks to Bob Zale for making me do this.
  6.  
  7. ' Routine list (detailed descriptions follow)
  8.  
  9. ' dBASE .DBF file access
  10. '    dBUse(STRING,INTEGER)
  11. '    dBGetRecord(DWORD,INTEGER)
  12. '    dBGetCField$(STRING,INTEGER)
  13. '    dBGetNField!(STRING,INTEGER)
  14. '    dBPutRecord(DWORD,INTEGER)
  15. '    dBPutCField(STRING, STRING, INTEGER)
  16. '    dBPutNField(STRING, SINGLE, INTEGER)
  17.  
  18. ' utilities
  19. '    dBGetASCII$()
  20. '    dBGetARRAY(STRING ARRAY,INTEGER)
  21. '
  22. ' index support
  23. '    dBSetIndexTo(IX$,Fld$,e%)
  24. '    dBCreateIndex(IX$, Fld$, e%)
  25. '    dBSearchIndex(Findme$,e%)
  26. '    dBSkip(NS%, e%)
  27. '    dBGotoTop(e%)
  28. '    dBGotoBottom(e%)
  29.  
  30. ' screen editing
  31. '    dBCreateFormat ()
  32. '    dBSetFormatTo (FormatFileName$,Ecode%)
  33. '    dBView ()
  34. '    dBEditFields (Ecode%)
  35. '    dBEditRecord (RecNum???,E%)
  36. '    dBAppendRecord (E%)
  37.  
  38. %FALSE = 0
  39. %TRUE = NOT %FALSE
  40. %INSERTSCAN = 3           ' Change these two to change shape of cursor
  41. %OVERWRITESCAN = 6        ' The higher the number, the smaller the cursor
  42.  
  43.  
  44. ' SUB or FUNCTION declaration            Example use and description
  45. '====================================    ===========================
  46. DECLARE SUB dBUse(STRING,INTEGER)      ' dBUse "TEST.DBF", ErrorCode%
  47.                        '  ErrorCode returns
  48.                        '   1 - file not found
  49.                        '   2 - Zero byte file
  50.                        '   3 - File has no fields
  51.                        '   4 - not a dBASE file
  52.  
  53. DECLARE SUB dBGetRecord(DWORD,INTEGER) ' dBGetRecord R???, ErrorCode%
  54.                        ' ErrorCode returns
  55.                        '   1 - database not open
  56.                        '   2 - record exceeds size
  57.                        '   3 - record => zero
  58.  
  59. DECLARE FUNCTION dBGetCField$(STRING,INTEGER)
  60.                        ' ErrorCode 1 if no such field
  61.                        ' A$=dBGetCField$("PHONE",e%)
  62.                        ' returns the string value of a
  63.                        ' character field
  64.  
  65. DECLARE FUNCTION dBGetNField!(STRING,INTEGER)
  66.                        ' A! = dBGetNField!("TOTAL",e%)
  67.                        ' ErrorCode 1 if no such field
  68.                        ' Returns a single precision number
  69.                        ' of a numeric field with proper
  70.                        ' decimal places
  71.  
  72. DECLARE SUB dBPutRecord(DWORD,INTEGER) ' dBPutRecord(R???,ErrorCode%)
  73.                        ' Returns error 1 if no dbase open
  74.                        ' Returns error 2 if record too hi
  75.                        ' Puts the current record in memory
  76.                        ' into the database at the record
  77.                        ' specified.  If record number is
  78.                        ' 1 higher than NumberOfRecords???
  79.                        ' or if it is 0 then the record will
  80.                        ' be appended to the database
  81.  
  82. DECLARE SUB dBPutCField(STRING, STRING, INTEGER)
  83.                        ' dBPutCField "NAME", "Erik", Ecode%
  84.                        ' returns error if no such field
  85.                        ' places a string value into a
  86.                        ' character field in memory
  87.  
  88. DECLARE SUB dBPutNField(STRING, SINGLE, INTEGER)
  89.                        ' dBPutNField "AGE", 27, Ecode%
  90.                        ' returns error if no such field
  91.                        ' places a numeric value into a
  92.                        ' character field in memory.  Numeric
  93.                        ' argument is formatted according to
  94.                        ' the design of the field
  95.  
  96. DECLARE SUB dBCreateFormat ()          ' runs a mini program to create a
  97.                        ' data entry screen format.  The
  98.                                        ' current format or a default format
  99.                                        ' (of up to 44 fields) is created.
  100.                                        ' you then move the fields around
  101.                                        ' on the screen with the arrow
  102.                                        ' keys and press ENTER when finished.
  103.  
  104. DECLARE SUB dBSetFormatTo(FormatFileName$,Ecode%)
  105.                     ' dBSetFormatTo "SCREEN1.FRM", E%
  106.                                         ' Loads screen edit format file and
  107.                                         ' returns.  If not successful error
  108.                                         ' code returns 1 for file not found.
  109.                                         ' If filename is nul string then
  110.                                         ' the current format is cleared.
  111.                                         ' Ecode% returns 1 if the format
  112.                                         ' file is not found.
  113.  
  114. DECLARE SUB dBView ()            ' Uses the current screen format to
  115.                     ' simply display the current record.
  116.                                         ' it does not pause.
  117.  
  118. DECLARE SUB dBEditFields(Ecode%)        ' uses the current screen format to
  119.                     ' display and then allow editing of
  120.                                         ' the current record in typical
  121.                                         ' dBASE fashion.  CTRL-END or F10
  122.                                         ' terminates and updates the record.
  123.                                         ' ESCAPE terminates and does not
  124.                                         ' update the record.
  125.  
  126. DECLARE SUB dBEditRecord(RecNum???,E%)  ' Gets a record and allows fullscreen
  127.                     ' editing using current screen format
  128.                                         ' or default screen format if no
  129.                                         ' current format is set.  e% returns
  130.                                         ' 1 if the specified record does not
  131.                                         ' exist.
  132.  
  133. DECLARE SUB dBAppendRecord(E%)          ' Creates a blank record and allows
  134.                     ' full screen editing.  If the record
  135.                                         ' is not aborted it will be appended
  136.                                         ' to the database.  Uses the current
  137.                                         ' screen format or default format if
  138.                                         ' no format is set.  e% returns 1 if
  139.                                         ' the record cannot be appended to
  140.                                         ' the database for whatever reason.
  141.  
  142. DECLARE FUNCTION dBGetASCII$()         ' A$ = dBGetASCII$
  143.                        ' returns a comma delimited ASCII
  144.                        ' record of the entire dBASE record
  145.                        ' currently in memory
  146.  
  147. DECLARE SUB dBGetARRAY(STRING ARRAY,INTEGER)
  148.                        ' dBGetARRAY DB$,e%
  149.                        ' fills the specified array with
  150.                        ' consecutive fields from the entire
  151.                        ' dBASE record currently in memory.
  152.                        ' ErrorCode 1 is array is too small
  153.  
  154. DECLARE SUB dBSetIndexTo(IX$,Fld$,e%)      ' Set index to file in IX$.  You must
  155.                                         ' specify the field which is being
  156.                                         ' indexed in order to properly update
  157.                                         ' the index during append or edit
  158.                                         ' operations.  The index must have
  159.                                         ' already been created using
  160.                                         ' dBCreateIndex.  E% returns 1 if the
  161.                                         ' database is not open, 2 if the
  162.                                         ' specified field is not in the
  163.                                         ' database, 3 if the index file
  164.                                         ' does not exist
  165.  
  166. DECLARE SUB dBCreateIndex(IX$, Fld$, e%)' Creates an index file specified in
  167.                     ' IX$.  You must specify the field
  168.                                         ' to index in FLD$.  As the file is
  169.                                         ' being indexed, record numbers are
  170.                                         ' printed to the screen at the
  171.                                         ' current cursor location.  e%
  172.                                         ' returns 1 if the database is not
  173.                                         ' open, 2 if the field does not
  174.                                         ' exist, 3 if the index can't be
  175.                                         ' created on disk, 4 if there is
  176.                                         ' an error reading the database,
  177.                                         ' 5 if the user aborts with ESC,
  178.